perm filename PORTS.SAI[KA,SYS] blob
sn#195743 filedate 1983-04-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGOF("PORTS")
C00005 00003 PUBLIC SIMPLE PROCEDURE PORTS! $"#
C00006 00004 PRIVATE STRING SIMPLE PROCEDURE ALFIZE(STRING FILENAME, LEFTRIGHT) $"#
C00009 00005 PUBLIC SIMPLE PROCEDURE FINPORTION $"#
C00010 00006 PUBLIC SIMPLE PROCEDURE DINSERT $"#
C00012 00007 PUBLIC SIMPLE PROCEDURE DPORTION $"#
C00015 00008 PUBLIC SIMPLE PROCEDURE DRECEIVE $"#
C00016 00009 PUBLIC SIMPLE PROCEDURE DSEND $"#
C00018 00010 PRIVATE INTEGER SIMPLE PROCEDURE LOG2(INTEGER BINARY) $"#
C00019 00011 PUBLIC SIMPLE PROCEDURE NOPORTION $"#
C00021 00012 PRIVATE PROCEDURE QUICKERSORT(INTEGER J, BASE) $"#
C00023 00013 PUBLIC SIMPLE PROCEDURE RECEIVE(INTEGER PORTIX STRING ALPHABETIZE) $"#
C00025 00014 PUBLIC SIMPLE PROCEDURE SEND(INTEGER PORTIX STRING MESSG) $"#
C00026 00015 PUBLIC BOOLEAN SIMPLE PROCEDURE STRLSS(INTEGER XI, YI) $"#
C00028 00016 FINISHED
C00029 ENDMK
C⊗;
BEGOF("PORTS")
COMMENT
*** Variations at Different Sites ***
TENEX PUB uses different naming conventions for generated and
intermediate files. ITS at MIT-AI can not open a channel for
successive input and output, as ALFIZE is accustomed to do.
***
PORTIONs, SENDs, and RECEIVEs.
The PORTYPE records in the ITBL heap include the following fields:
PORCH is the status, keeping track of occurrences of PORTION, INSERT,
SEND, and RECEIVE... in particular, if PORCH>0, then it is the
channel number used for SENDs. PORSEQ is the link to the next portion
in proper collating sequence. PORSTR points to an associated record
in STBL with fields: PORFIL, the file name of the generated file, and
PORINT, the file name of the intermediate file.
The pseudo-portion FOOT is distinguished by a PORCH of -1.
;
INTEGER SVSHED ; comment, value of SHED before Alphabetizing began ;
PROCEDURES
PUBLIC SIMPLE PROCEDURE PORTS! ;$"#
BEGIN "PORTS!"
UPCAS3←(UPCASE(0)) LOR '3000000 ; COMMENT POINT 7, CHARTBL(3), 6 ;
UPCAS5←(UPCASE(0)) LOR '5000000 ; UPCAS6←(UPCASE(0)) LOR '6000000 ;
FOR J ← 0 THRU 127 DO DPB(J, UPCASE(J)) ;
FOR J ← "a" THRU "z" DO DPB(J-("a"-"A"), UPCASE(J)) ; DPB(J←"!", UPCASE("_")) ;
INTERS ← NPORTS ← THISPORT ← 0 ; PORTLL ← SEQPORT ← PUTI(4, -5) ; PORSEQ(SEQPORT) ← INTER ← -1 ;
PORSTR(SEQPORT) ← PUTS(NULL) ; PUTS(NULL) ;
END "PORTS!" ;
PRIVATE STRING SIMPLE PROCEDURE ALFIZE(STRING FILENAME, LEFTRIGHT) ;$"#
BEGIN "ALFIZE"
INTEGER SVIHIGH, SVSHIGH, CHAN, LEFT, RIGHT, N, I ; STRING S, KEY ;
SVSHED ← SHED ; SVIHIGH ← IHIGH ; SVSHIGH ← SHIGH ;
IF (CHAN←GETCHAN)<0 THEN
BEGIN
WARN(NULL,"No Channel to Alphabetize "&FILENAME) ;
RETURN(NULL) ;
END ;
EOF ← 0 ; OPEN(CHAN, "DSK", 0, 2, IFC ITSVER THENC 0 ELSEC 2 ENDC, 150, BRC, EOF) ;
LOOKUP(CHAN, IFC TENEX THENC IFILENAME & GENEXT & ENDC FILENAME, FLAG) ;
IF FLAG THEN
BEGIN
WARN(NULL,"No Generated file "&FILENAME) ;
RETURN(NULL) ;
END ;
SETBREAK(LOCAL!TABLE, LEFTRIGHT&LF, NULL, "IS") ; LEFT ← LOP(LEFTRIGHT) ; RIGHT ← LOP(LEFTRIGHT) ; N ← 0 ;
DO BEGIN "SENDEE"
S ← INPUT(CHAN, TO!TB!FF!SKIP) ; IF EOF THEN DONE ; S ← S & TB ;
DO S ← S & INPUT(CHAN, LOCAL!TABLE) UNTIL BRC=LEFT OR BRC=LF OR EOF ;
IF BRC = LEFT THEN
BEGIN "KEY"
KEY ← NULL ; S ← S & LEFT ;
DO KEY ← KEY & INPUT(CHAN, LOCAL!TABLE) UNTIL BRC=RIGHT OR BRC=LF OR EOF ;
PUSHS(1,KEY) ; comment, Sort Key in SSTK ;
S ← S & KEY ;
IF BRC = RIGHT THEN
BEGIN
S ← S & RIGHT ;
DO S ← S & INPUT(CHAN, LOCAL!TABLE) UNTIL BRC = LF OR EOF ;
END ;
END "KEY" ;
PUTS(S&LF) ; comment, complete entry in STBL ;
N ← N + 1 ; PUTI(1, N) ; comment, Sort Tags in ITBL ;
END "SENDEE"
UNTIL EOF ;
QUICKERSORT(N, SVIHIGH) ;
CLOSIN(CHAN) ; FILENAME ← IFC TENEX THENC
IFILENAME & ALFEXT & FILENAME ELSEC
FILENAME[1 TO ∞-1] & "Z" ENDC ;
IFC ITSVER THENC OPEN(CHAN, "DSK", 0, 0, 2, 150, BRC, EOF) ; ENDC
ENTER(CHAN, FILENAME, FLAG) ; comment, "---.PUZ" or "---.ALF---";
IF FLAG THEN
BEGIN
WARN(NULL,"ENTER failed for Alphabetized File "&FILENAME) ;
RETURN(NULL) ;
END ;
FOR I ← 1 THRU N DO OUT(CHAN, STBL[SVSHIGH + ITBL[SVIHIGH + I]]) ;
RELEASE(CHAN) ; SHED ← SVSHED ; IHIGH ← SVIHIGH ; SHIGH ← SVSHIGH ; RETURN(FILENAME) ;
END "ALFIZE" ;
PUBLIC SIMPLE PROCEDURE FINPORTION ;$"#
BEGIN
DBREAK ;
IF OLDPGIDA THEN NEXTPAGE ;
END "FINPORTION" ;
PUBLIC SIMPLE PROCEDURE DINSERT ;$"#
BEGIN
INTEGER CHAN, PIX, ROTTEN ;
IF ON THEN BEGIN TES 4/11/74;
FINPORTION ;
IF INTER GEQ 0 THEN
BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) ; SINTER←INTER←-1 END ;
END ;
DO BEGIN "COLLATE"
DPASS ; IF NOT THISISID THEN BEGIN WARN("=","Unnamed INSERT Portion!") ; RETURN END ;
IF ON THEN
BEGIN ROTTEN ← FALSE ;
IF THISTYPE NEQ PORTYPE THEN
BEGIN
BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -5));
PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL) ; TES 3/21/74;
END
ELSE IF (CHAN ← PORCH(PIX ← IX)) = -1 THEN BEGIN WARN("=","Can't INSERT FOOT!"); ROTTEN←TRUE END
ELSE IF NOT (0 LEQ CHAN LEQ 15) THEN BEGIN WARN("=","Can't INSERT passed PORTION "&THISWD) ; ROTTEN←TRUE END ;
IF NOT ROTTEN THEN BEGIN PORSEQ(SEQPORT) ← PIX ; PORSEQ(SEQPORT ← PIX) ← -1 END ;
PASS ;
END ;
END "COLLATE" UNTIL NOT ITSCH(<,>) ;
END "DINSERT" ;
PUBLIC SIMPLE PROCEDURE DPORTION ;$"#
BEGIN
INTEGER CHAN, PSIX, PIX ; STRING IFIL ; LABEL WASFWD ;
DPASS ; IF NOT THISISID THEN BEGIN WARN("=","Unnamed PORTION!") ; RETURN END ;
IF NOT ON THEN BEGIN PASS ; RETURN END ;
FINPORTION ;
IF THISTYPE NEQ PORTYPE THEN
BEGIN
BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -2)) ;
PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL);
PORSEQ(PIX) ← 0 ;
END
ELSE IF 0 LEQ (CHAN ← PORCH(PIX ← IX)) THEN BEGIN RELEASE(CHAN) ; PORCH(PIX) ← -3 ; GO TO WASFWD END
ELSE IF CHAN = -1 THEN BEGIN WARN("=","Can't declare PORTION FOOT!") ; PASS ; RETURN END
ELSE IF CHAN NEQ -5 THEN WARN("=","PORTION "&THISWD&" already declared!")
ELSE IF PORSEQ(THISPORT) NEQ PIX THEN
BEGIN PORCH(PIX) ← -2 ; COMMENT ADDED FEB 6, 1973 ;
WASFWD: BEGIN
IF INTER GEQ 0 THEN
BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) END ;
INTER ← SINTER ← -1 ;
END ;
END ;
IF INTER < 0 THEN
BEGIN
PSIX ← PORSTR(PIX) ;
IFCR TENEX THENC
IFIL ← CVS(INTERS←INTERS+1) ; PORINT(PSIX) ← IFIL ;
INTER ← WRITEON(TRUE,IFILENAME&OCTEXT&IFIL) ;
SINTER← WRITEON(FALSE,IFILENAME&TXTEXT&IFIL) ;
ELSEC
IFIL ← "PUI"&CVS(INTERS←INTERS+1) ;
PORINT(PSIX)←IFIL ;
INTER←WRITEON(TRUE,IFIL&PUIEXT) ; SINTER←WRITEON(FALSE,IFIL&"S"&PUIEXT) ;
ENDC
END ;
IF PORSEQ(PIX) = 0 THEN
BEGIN
PORSEQ(SEQPORT) ← PIX ;
SEQPORT ← PIX ;
END ;
THISPORT ← PIX ; NPORTS ← NPORTS + 1 ;
PASS ;
END "DPORTION" ;
PUBLIC SIMPLE PROCEDURE DRECEIVE ;$"#
BEGIN
STRING A ;
IF THATISCON AND 1 LEQ LENGTH(THATWD)-1 LEQ 2 THEN BEGIN PASS ; A ← THISWD[2 TO ∞] END
ELSE A ← NULL ;
IF ON THEN RECEIVE(THISPORT, A) ; PASS ;
END "DRECEIVE" ;
PUBLIC SIMPLE PROCEDURE DSEND ;$"#
BEGIN
INTEGER PIX; STRING FI ;
INTEGER SIMPLE PROCEDURE OPORT ;
BEGIN INTEGER CH ; CH←WRITEON(FALSE,
IFCR TENEX THENC IFILENAME&GENEXT&(FI←THISWD) ELSEC
(FI←(CVS(NPORTS←NPORTS+1)&THISWD)[1 TO 5])&PUGEXT ENDC) ;
RETURN(CH) ; END "OPORT" ;
PASS ; IF NOT THISISID THEN BEGIN WARN("=","SEND Where?") ; RETURN END ;
IF NOT ON THEN BEGIN PASS ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
IF THISTYPE NEQ PORTYPE THEN
BEGIN
BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, OPORT) ) ;
PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL) ;
PORSEQ(PIX) ← 0 ; PORFIL(PORSTR(PIX)) ← FI ;
END
ELSE IF PORCH(PIX←IX)=-5 THEN
BEGIN PORCH(PIX)←OPORT ; PORFIL(PORSTR(PIX))←FI END ;
PASS ;
SEND(PIX, DEFN(TRUE,PORCH(PIX) NEQ -1,0,0)) ;
END "DSEND" ;
PRIVATE INTEGER SIMPLE PROCEDURE LOG2(INTEGER BINARY) ;$"#
BEGIN "LOG2"
INTEGER I ; I ← 0 ;
WHILE BINARY > 1 DO BEGIN I ← I + 1 ; BINARY ← BINARY DIV 2 END ;
RETURN(I) ;
END "LOG2" ;
PUBLIC SIMPLE PROCEDURE NOPORTION ;$"#
BEGIN "NOPORTION"
STRING IFIL ; INTEGER PSIX, PIX ;
WARN("=","No PORTION Declaration Found") ;
IFIL ← IFC NOT TENEX THENC "PUI"& ENDC CVS(INTERS←INTERS+1) ;
THISPORT ← PIX ← PUTI(4, -2) ;
PORSTR(PIX) ← PSIX ← PUTS(NULL) ; PUTS(NULL) ; TES 3/21/74;
PORINT(PSIX) ← IFIL ; PORSEQ(SEQPORT) ← PIX ; PORSEQ(SEQPORT←PIX) ← 0 ;
NPORTS ← NPORTS + 1 ;
IFC TENEX THENC
INTER ← WRITEON(TRUE, IFILENAME & OCTEXT & IFIL) ;
SINTER← WRITEON(FALSE,IFILENAME & TXTEXT & IFIL) ;
ELSEC
INTER ← WRITEON(TRUE, IFIL & PUIEXT) ; SINTER ← WRITEON(FALSE, IFIL & "S"&PUIEXT) ;
ENDC
END "NOPORTION" ;
PRIVATE PROCEDURE QUICKERSORT(INTEGER J, BASE) ;$"#
BEGIN "QUICKERSORT" comment, Ascending SORT for ALFIZE ;
INTEGER I, K, Q, M, P, T, X ; INTEGER ARRAY UT,LT[1:LOG2(J+2)+1] ;
COMMENT Algorithm 271 (R. S. Scowen) CACM 8,11 (Nov. 1965) pp 669-670 ;
DEFINE A(L) = [ITBL[BASE+L]] ;
LABEL N, L, MM, PP ;
I ← M ← 1 ;
N: IF J-I > 1 THEN
BEGIN
P ← (J+I) DIV 2 ; T ← A(P) ; A(P) ← A(I) ; Q ← J ;
FOR K ← I + 1 THRU Q DO
BEGIN
IF STRLSS(T, A(K)) THEN
BEGIN
FOR Q ← Q DOWN K DO
BEGIN
IF STRLSS(A(Q), T) THEN
BEGIN
A(K) SWAP A(Q) ; Q ← Q - 1 ;
GO TO L ;
END ;
END ;
Q ← K - 1 ;
GO TO MM ;
END ;
L:
END ;
MM:
A(I) ← A(Q) ; A(Q) ← T ;
IF Q+Q > I+J THEN BEGIN LT[M]←I; UT[M]←Q-1; I←Q+1 END
ELSE BEGIN LT[M]←Q+1; UT[M]←J; J←Q-1 END ;
M ← M + 1 ;
GO TO N ;
END
ELSE IF I GEQ J THEN GO TO PP
ELSE BEGIN
IF STRLSS(A(J),A(I)) THEN A(I) SWAP A(J) ;
PP: M ← M - 1 ;
IF M > 0 THEN BEGIN I←LT[M]; J←UT[M]; GO TO N END ;
END ;
END "QUICKERSORT" ;
PUBLIC SIMPLE PROCEDURE RECEIVE(INTEGER PORTIX; STRING ALPHABETIZE) ;$"#
BEGIN "RECEIVE"
INTEGER CH ; STRING FIL ; LABEL TWICE ;
CASE (CH ← PORCH(PORTIX)) + 6 MIN 6 OF
BEGIN
COMMENT -6 ; GO TO TWICE ;
COMMENT -5 Only INSERTed ; IMPOSSIBLE("RECEIVE") ;
COMMENT -4 ; TWICE: WARN(NULL,"Already RECEIVEd generated file for this PORTION") ;
COMMENT -3 ; BEGIN "GENFILE"
FIL ← PORFIL(PORSTR(PORTIX)) IFC NOT TENEX THENC & PUGEXT ENDC ;
IF FULSTR(ALPHABETIZE) THEN BEGIN FIL←ALFIZE(FIL,ALPHABETIZE) ; PORCH(PORTIX)←-6 END
ELSE BEGIN PORCH(PORTIX) ← -4 ; IFC TENEX THENC
FIL←IFILENAME & GENEXT & FIL ENDC END ;
AGENFILE ← TRUE ; SWICHF(FIL) ; PAGESCAN(LAST) ← -PAGESCAN(LAST) ;
END "GENFILE" ;
COMMENT -2 Never SENT ; BEGIN END ;
COMMENT -1 ; BEGIN CH←FOOTSTR(AREAIXM); SWICH(SSTK[CH],-1,0); SSTK[CH]←NULL END ;
COMMENT 0-15 ; IMPOSSIBLE("RECEIVE") ;
END ;
END "RECEIVE" ;
PUBLIC SIMPLE PROCEDURE SEND(INTEGER PORTIX; STRING MESSG) ;$"#
BEGIN "SEND"
INTEGER CH ;
IF 0 LEQ (CH ← PORCH(PORTIX)) THEN OUT(CH,MESSG)
ELSE IF CH=-1 THEN
BEGIN
IF NOPGPH THEN ASSUREAREA ; TES 8/19/74 FIX BUG ;
CH←FOOTSTR(IF AREAIXM THEN AREAIXM ELSE IXTEXT); TES 8/19/74 ;
SSTK[CH]←SSTK[CH]&MESSG ;
END
ELSE WARN(NULL,"Can't send to a passed PORTION:"&MESSG) ;
END "SEND" ;
PUBLIC BOOLEAN SIMPLE PROCEDURE STRLSS(INTEGER XI, YI) ;$"#
BEGIN "STRLSS"
INTEGER XL, YL, MINL, L ; STRING X, Y ;
X ← SSTK[SVSHED + XI] ; Y ← SSTK[SVSHED + YI] ;
XL ← LENGTH(X) ; YL ← LENGTH(Y) ; MINL ← XL MIN YL ;
START!CODE "STRCOM"
LABEL NEXC, SAME, DIFF ;
MOVE 2, X ; MOVE 3, Y ; SKIPN 4, MINL ; JRST SAME ;
NEXC: ILDB 5, 2 ; LDB 5, UPCAS5 ; ILDB 6, 3 ; LDB 6, UPCAS6 ;
CAME 5, 6 ; JRST DIFF ; SOJG 4, NEXC ;
SAME: COMMENT SAME FOR FIRST MINL CHARACTERS ;
MOVE 5, XL ; MOVE 6, YL ; CAME 5, 6 ; JRST DIFF ;
COMMENT AND SAME LENGTH: ; MOVE 5, XI ; MOVE 6, YI ;
DIFF: CAML 5, 6 ; TDZA 1,1 ; MOVEI 1, -1 ; MOVEM 1, L ;
END ;
RETURN(L) ;
END "STRLSS" ;
FINISHED
ENDOF("PORTS")